home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Object = "{B0EDF154-910A-11D2-B632-00C04F79498E}#1.0#0"; "msvidctl.dll"
- Begin VB.Form frmMain
- BorderStyle = 3 'Fixed Dialog
- Caption = "Microsoft Video Control - VB Sample Application"
- ClientHeight = 4875
- ClientLeft = 2130
- ClientTop = 2730
- ClientWidth = 9135
- Icon = "main.frx":0000
- LinkTopic = "Form1"
- LockControls = -1 'True
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 325
- ScaleMode = 3 'Pixel
- ScaleWidth = 609
- ShowInTaskbar = 0 'False
- Begin VB.TextBox txtChannel
- Height = 375
- Left = 1200
- TabIndex = 25
- Top = 2160
- Visible = 0 'False
- Width = 615
- End
- Begin VB.TextBox txtSID
- Height = 375
- Left = 1200
- TabIndex = 23
- Top = 1680
- Visible = 0 'False
- Width = 615
- End
- Begin VB.CommandButton cmdInfo
- Caption = "Info"
- Height = 495
- Left = 1200
- TabIndex = 22
- ToolTipText = "Display tuner information and FPS count"
- Top = 1080
- Visible = 0 'False
- Width = 855
- End
- Begin VB.CommandButton cmdEnterDVB
- Caption = "Enter"
- Height = 495
- Left = 120
- TabIndex = 20
- ToolTipText = "Enter DVB Channel"
- Top = 1800
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdViewNext
- Caption = "Next Tuner"
- Height = 495
- Left = 120
- TabIndex = 19
- ToolTipText = "Select the next tuner in the list"
- Top = 1080
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdCaptureOff
- Caption = "Hide Capture"
- Height = 495
- Left = 7305
- TabIndex = 18
- ToolTipText = "Click to hide the captured frame window"
- Top = 3960
- Visible = 0 'False
- Width = 1695
- End
- Begin VB.CommandButton cmdSeekUpDigital
- Caption = "Ch. Up"
- Height = 495
- Left = 1200
- TabIndex = 17
- ToolTipText = "ATSC Physical Channel Up"
- Top = 3600
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdVolumeDown
- Caption = "Vol. Down"
- Height = 495
- Left = 2280
- TabIndex = 16
- ToolTipText = "Click to decrease volume"
- Top = 4200
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdSeekDownDigital
- Caption = "Ch. Down"
- Height = 495
- Left = 1200
- TabIndex = 15
- ToolTipText = "ATSC Physical Channel Down"
- Top = 4200
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdCapture
- Caption = "Capture Video Frame"
- Height = 495
- Left = 4200
- TabIndex = 14
- ToolTipText = "Click to capture a frame of video"
- Top = 3960
- Visible = 0 'False
- Width = 1815
- End
- Begin VB.CommandButton cmdEnterAnalog
- Caption = "Enter"
- Height = 495
- Left = 120
- TabIndex = 13
- ToolTipText = "Enter NTSC Channel"
- Top = 2400
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdEnterATSC
- Caption = "Enter"
- Height = 495
- Left = 120
- TabIndex = 12
- ToolTipText = "Enter ATSC Channel"
- Top = 3000
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdVolumeUp
- Caption = "Vol. Up"
- Height = 495
- Left = 2280
- TabIndex = 11
- ToolTipText = "Click to increase volume"
- Top = 3600
- Visible = 0 'False
- Width = 975
- End
- Begin VB.TextBox txtMinorChannel
- Height = 375
- Left = 1200
- TabIndex = 8
- Top = 3120
- Visible = 0 'False
- Width = 615
- End
- Begin VB.TextBox txtPhysicalChannel
- Height = 375
- Left = 1200
- TabIndex = 6
- Top = 2640
- Visible = 0 'False
- Width = 615
- End
- Begin VB.CommandButton cmdSeekDownAnalog
- Caption = "Ch. Down"
- Height = 495
- Left = 120
- TabIndex = 5
- ToolTipText = "NTSC Channel Down"
- Top = 4200
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdSeekUpAnalog
- Caption = "Ch. Up"
- Height = 495
- Left = 120
- TabIndex = 4
- ToolTipText = "NTSC Channel Up"
- Top = 3600
- Visible = 0 'False
- Width = 975
- End
- Begin VB.CommandButton cmdPowerOff
- Caption = "Power Off"
- Height = 495
- Left = 2760
- TabIndex = 3
- ToolTipText = "Done with playback of selected source"
- Top = 1680
- Visible = 0 'False
- Width = 1095
- End
- Begin VB.CommandButton cmdPowerOn
- Caption = "Power On"
- Height = 495
- Left = 2760
- TabIndex = 2
- ToolTipText = "Start playing selected source (please be patient)"
- Top = 1080
- Width = 1095
- End
- Begin VB.ComboBox cbSource
- Height = 315
- Left = 120
- TabIndex = 0
- Text = "Combo1"
- ToolTipText = "Choose one of the tuners from the combo box and press Power On. Note that building the graph may take up to 10 seconds."
- Top = 480
- Width = 3975
- End
- Begin VB.Label lblChannel
- Caption = "Channel"
- Height = 255
- Left = 1920
- TabIndex = 26
- Top = 2220
- Visible = 0 'False
- Width = 735
- End
- Begin VB.Label lblSID
- Caption = "SID"
- Height = 255
- Left = 1920
- TabIndex = 24
- Top = 1740
- Visible = 0 'False
- Width = 495
- End
- Begin VB.Label lblInfo
- Height = 375
- Left = 4200
- TabIndex = 21
- Top = 4440
- Visible = 0 'False
- Width = 3735
- End
- Begin MSVidCtlLibCtl.MSVidCtl VidControl
- Height = 3600
- Left = 4200
- TabIndex = 10
- ToolTipText = "Microsoft Video Control window"
- Top = 240
- Width = 4800
- _cx = 42672403
- _cy = 42670286
- AutoSize = 0 'False
- Enabled = -1 'True
- Object.TabStop = -1 'True
- BackColor = 0
- End
- Begin VB.Label lblMinorChannel
- Caption = "Minor Channel"
- Height = 255
- Left = 1920
- TabIndex = 9
- Top = 3180
- Visible = 0 'False
- Width = 1455
- End
- Begin VB.Label lblPhysicalChannel
- Caption = "Physical Channel"
- Height = 255
- Left = 1920
- TabIndex = 7
- Top = 2700
- Visible = 0 'False
- Width = 1335
- End
- Begin VB.Label lblSourceInUse
- Caption = "Playback Source"
- Height = 255
- Left = 120
- TabIndex = 1
- Top = 120
- Visible = 0 'False
- Width = 3975
- End
- Attribute VB_Name = "frmMain"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '*******************************************************************************
- '* This is a part of the Microsoft Platform SDK Code Samples.
- '* Copyright (C) 1999-2001 Microsoft Corporation.
- '* All rights reserved.
- '* This source code is only intended as a supplement to
- '* Microsoft Development Tools and/or SDK documentation.
- '*******************************************************************************
- 'Microsoft Video Control - Sample Visual Basic Application
- Option Explicit
- Dim TVPlayer As MSVidAnalogTunerDevice
- Dim ATSCTune As IATSCChannelTuneRequest
- Dim AnalogTune As IChannelTuneRequest
- Dim DVBTune As IDVBTuneRequest
- Dim AnalogTV As AnalogTVTuningSpace
- Dim ATSCTV As New ATSCTuningSpace
- Dim DVBSTV As New DVBSTuningSpace
- Dim ATSCLoc As New ATSCLocator
- Sub Form_Load()
- cbSource.AddItem ("NTSC Analog TV")
- cbSource.AddItem ("NTSC Analog TV w/CC")
- cbSource.AddItem ("ATSC Digital Antenna TV")
- cbSource.AddItem ("ATSC Digital Antenna TV w/CC & Mixing Mode")
- cbSource.AddItem ("DVB-S Digital TV")
- cbSource.AddItem ("DVB-S Digital TV w/CC & Mixing Mode")
- cbSource.Text = "Choose a playback source and click Power On"
- End Sub
- Sub cmdPowerOn_click()
- 'This function builds the correct graph depending on the user-selected broadcast type
- On Error GoTo ON_ERROR
- Dim TuningSpaceContainer As SystemTuningSpaces
- Set TuningSpaceContainer = CreateObject("BDATuner.SystemTuningSpaces")
- Dim TuningSpaceCollection As ITuningSpaces
- Dim TS As ITuningSpace
- Dim FeaturesColl As New MSVidFeatures
- Dim FeaturesAvailableColl As MSVidFeatures
- Dim Feature As IMSVidFeature
- Dim counter As Integer
- VidControl.MaintainAspectRatio = True
- VidControl.AutoSize = False
- 'NTSC Analog TV playback init
- If cbSource.Text = "NTSC Analog TV" Then
- 'Find all of the AnalogTV tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(NTSC_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find an NTSC Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick the tuning space named Cable
- For Each TS In TuningSpaceCollection
- If TS.UniqueName = "Cable" Then
- Set AnalogTV = TS
- End If
- Next
-
- If Not (AnalogTV.UniqueName = "Cable") Then
- MsgBox ("Couldn't find the cable TV tuning space on your system. Re-install this tuning space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Create an AnalogTV tune request and view it
- Set AnalogTune = AnalogTV.CreateTuneRequest
- AnalogTune.Channel = 5
- VidControl.View AnalogTune
- CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
-
- 'Set FeaturesActive to nothing to disable CC (if it is on)
- Set FeaturesColl = New MSVidFeatures
- Set FeaturesColl = Nothing
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with setting the FeaturesActive collection to NULL."
-
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- txtChannel.Text = VidControl.InputActive.Tune.Channel
- Call MakeAnalogTVToolsVisible
- 'NTSC Analog TV playback init w/CC
- ElseIf cbSource.Text = "NTSC Analog TV w/CC" Then
- 'Find all of the AnalogTV tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(NTSC_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find an NTSC Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick the tuning space named Cable
- For Each TS In TuningSpaceCollection
- If TS.UniqueName = "Cable" Then
- Set AnalogTV = TS
- End If
- Next
-
- If Not (AnalogTV.UniqueName = "Cable") Then
- MsgBox ("Couldn't find the cable TV tuning space on your system. Please reinstall this tuning space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Create an AnalogTV tune request and view it
- Set AnalogTune = AnalogTV.CreateTuneRequest
- AnalogTune.Channel = 5
- VidControl.View AnalogTune
- CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
-
- 'Enable CC
- Set FeaturesAvailableColl = VidControl.FeaturesAvailable
- CheckError "There was a problem getting the FeaturesAvailable collection."
-
- For Each Feature In FeaturesAvailableColl
- If Feature.ClassID = CC_GUID Then
- Dim CCObj As MSVidClosedCaptioning
- Set CCObj = Feature
- CCObj.Enable = True
- FeaturesColl.Add Feature
- CheckError "There was a problem adding a feature to the collection."
- ElseIf Feature.ClassID = DATASVC_GUID Then
- FeaturesColl.Add Feature
- CheckError "There was a problem adding a feature to the collection."
- End If
- Next
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with setting the FeaturesActive collection."
-
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- txtChannel.Text = VidControl.InputActive.Tune.Channel
- Call MakeAnalogTVToolsVisible
- 'Digital TV playback init
- ElseIf cbSource.Text = "ATSC Digital Antenna TV" Then
- 'Find the all of ATSC tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(ATSC_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find an ATSC Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick the tuning space named ATSC
- For Each TS In TuningSpaceCollection
- If TS.UniqueName = "ATSC" Then
- Set ATSCTV = TS
- End If
- Next
-
- If Not (ATSCTV.UniqueName = "ATSC") Then
- MsgBox ("Couldn't find the ATSC TV tuning space on your system. Please reinstall this tuning space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Create a ATSC tune request and view it
- Set ATSCTune = ATSCTV.CreateTuneRequest
- ATSCLoc.PhysicalChannel = 46
- ATSCTune.Channel = -1
- ATSCTune.MinorChannel = -1
- ATSCTune.Locator = ATSCLoc
-
- 'Set FeaturesActive to nothing to disable CC (if it is on)
- Set FeaturesColl = New MSVidFeatures
- 'Set FeaturesColl = Nothing
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with setting the FeaturesActive collection to NULL."
- VidControl.View ATSCTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- VidControl.Build
- CheckError "Build"
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
- txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
- Call MakeDigitalTVToolsVisible
- 'Hide these two buttons, as we can't mix in this mode
- cmdCapture.Visible = False
- cmdCaptureOff.Visible = False
-
- 'Digital TV w/CC playback init
- ElseIf cbSource.Text = "ATSC Digital Antenna TV w/CC & Mixing Mode" Then
- 'Find the all of ATSC tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(ATSC_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find an ATSC Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick the tuning space named ATSC
- For Each TS In TuningSpaceCollection
- If TS.UniqueName = "ATSC" Then
- Set ATSCTV = TS
- End If
- Next
-
- If Not (ATSCTV.UniqueName = "ATSC") Then
- MsgBox ("Couldn't find the ATSC TV tuning space on your system. Please reinstall this tuning space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Create a ATSC tune request and view it
- Set ATSCTune = ATSCTV.CreateTuneRequest
- ATSCLoc.PhysicalChannel = 46
- ATSCTune.Channel = -1
- ATSCTune.MinorChannel = -1
- ATSCTune.Locator = ATSCLoc
- VidControl.View ATSCTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
-
- 'Enable CC (and mixing mode)
- Set FeaturesAvailableColl = VidControl.FeaturesAvailable
- CheckError "There was a problem getting the FeaturesAvailable collection."
-
- For Each Feature In FeaturesAvailableColl
- If Feature.ClassID = CC_GUID Then
- FeaturesColl.Add Feature
- CheckError "There was a problem adding a feature to the collection."
- End If
- Next
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with putting the FeaturesActive collection."
-
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
- txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
- Call MakeDigitalTVToolsVisible
-
- 'Digital DVB-S TV playback init
- ElseIf cbSource.Text = "DVB-S Digital TV" Then
- 'Find all of the DVB-S tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(DVBS_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find a DVB Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick any DVB-S tuning space we find
- For Each TS In TuningSpaceCollection
- If TS.UniqueName = "MYDVB" Then
- Set DVBSTV = TS
- Exit For
- End If
- Next
-
- If (IsNull(DVBSTV)) Then
- 'If there is no tuning space exit
- MsgBox ("No MYDVB tuning space found. Please run the ViewDVB.htm file first")
- Call cmdPowerOff_click
- End If
- 'Create a DVB tune request and view it
- Set DVBTune = DVBSTV.CreateTuneRequest
- CheckError "There was a problem creating a DVB-S tune request."
- DVBTune.SID = 101
-
- 'Set FeaturesActive to nothing to disable CC (if it is on)
- Set FeaturesColl = New MSVidFeatures
- Set FeaturesColl = Nothing
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with setting the FeaturesActive collection to NULL."
- VidControl.View DVBTune
- CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- Call MakeDigitalTVToolsVisible
- txtSID.Visible = True
- lblSID.Visible = True
- cmdEnterDVB.Visible = True
- 'Hide these buttons, as they aren't used for DVB
- cmdCapture.Visible = False
- cmdCaptureOff.Visible = False
- txtPhysicalChannel.Visible = False
- txtMinorChannel.Visible = False
- lblPhysicalChannel.Visible = False
- lblMinorChannel.Visible = False
- txtChannel.Visible = False
- cmdEnterATSC.Visible = False
- cmdSeekUpDigital.Visible = False
- cmdSeekDownDigital.Visible = False
-
- 'Digital DVB-S TV w/CC playback init
- ElseIf cbSource.Text = "DVB-S Digital TV w/CC & Mixing Mode" Then
- 'Find all of the DVB-S tuning spaces
- Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(DVBS_GUID)
- If TuningSpaceCollection.Count = 0 Then
- MsgBox ("Couldn't find a DVB Tuning Space.")
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- 'Pick any DVB-S tuning space we find
- For Each TS In TuningSpaceCollection
- If Not (TS Is Nothing) Then
- Set DVBSTV = TS
- End If
- Next
-
- 'Create a DVB tune request and view it
- Set DVBTune = DVBSTV.CreateTuneRequest
- CheckError "There was a problem creating the DVB-S tune request."
- DVBTune.SID = 101
- VidControl.View DVBTune
- CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
-
- 'Enable CC (and mixing mode)
- Set FeaturesAvailableColl = VidControl.FeaturesAvailable
- CheckError "There was a problem getting the FeaturesAvailable collection."
-
- For Each Feature In FeaturesAvailableColl
- If Feature.ClassID = CC_GUID Then
- FeaturesColl.Add Feature
- CheckError "There was a problem adding a feature to the collection."
- End If
- Next
- VidControl.FeaturesActive = FeaturesColl
- CheckError "There was a problem with putting the FeaturesActive collection."
-
- VidControl.Run
- CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
- If (VidControl.State = STATE_UNBUILT) Then
- Call cmdPowerOff_click
- Exit Sub
- End If
-
- Call MakeDigitalTVToolsVisible
- txtSID.Visible = True
- lblSID.Visible = True
- cmdEnterDVB.Visible = True
- 'Hide the objects that aren't needed for DVB
- txtPhysicalChannel.Visible = False
- txtMinorChannel.Visible = False
- lblPhysicalChannel.Visible = False
- lblMinorChannel.Visible = False
- txtChannel.Visible = False
- cmdEnterATSC.Visible = False
- cmdSeekUpDigital.Visible = False
- cmdSeekDownDigital.Visible = False
-
- 'User didn't pick a playback type
- Else
- MsgBox "You have chosen a playback type that is not implemented. Please try again."
- End If
- Exit Sub
- ON_ERROR:
- Call ProcessGeneralErorr
- End Sub
- Sub ProcessGeneralErorr()
- On Error Resume Next
- VidControl.Stop
- VidControl.Decompose
- ATSCTune = Null
- AnalogTune = Null
- DVBTune = Null
- AnalogTV = Null
- ATSCTV = Null
- DVBSTV = Null
- ATSCLoc = Null
- CheckError "General error - graph cannot run"
- End Sub
- 'User is done with this playback
- Sub cmdPowerOff_click()
- On Error Resume Next
- Call HideTools
- VidControl.Stop
- VidControl.Decompose
- CheckError "There was a problem tearing down the graph."
- End Sub
- Sub MakeAnalogTVToolsVisible()
- 'Make the appropriate analog TV controls visible
- cmdPowerOff.Visible = True
- cmdCapture.Visible = True
- cmdCaptureOff.Visible = True
- cmdEnterAnalog.Visible = True
- lblChannel.Visible = True
- txtChannel.Visible = True
- lblSourceInUse.Caption = cbSource.Text
- lblSourceInUse.Visible = True
- cbSource.Visible = False
- txtChannel.Text = AnalogTune.Channel
- cmdVolumeUp.Visible = True
- cmdVolumeDown.Visible = True
- cmdSeekUpAnalog.Visible = True
- cmdSeekDownAnalog.Visible = True
- cmdViewNext.Visible = True
- cmdInfo.Visible = True
- End Sub
- Sub MakeDigitalTVToolsVisible()
- 'Make the appropriate TV controls visible
- cmdPowerOff.Visible = True
- cmdCapture.Visible = True
- cmdCaptureOff.Visible = True
- cmdSeekUpDigital.Visible = True
- cmdSeekDownDigital.Visible = True
- cmdEnterATSC.Visible = True
- lblSourceInUse.Caption = cbSource.Text
- cbSource.Visible = False
- lblSourceInUse.Visible = True
- lblMinorChannel.Visible = True
- txtMinorChannel.Visible = True
- lblPhysicalChannel.Visible = True
- txtPhysicalChannel.Visible = True
- cmdVolumeUp.Visible = True
- cmdVolumeDown.Visible = True
- cmdViewNext.Visible = True
- cmdInfo.Visible = True
- End Sub
- 'Hide all the controls we don't need to see
- Sub HideTools()
- cmdPowerOff.Visible = False
- cmdCapture.Visible = False
- cmdCaptureOff.Visible = False
- cmdSeekUpAnalog.Visible = False
- cmdSeekDownAnalog.Visible = False
- cmdSeekUpDigital.Visible = False
- cmdSeekDownDigital.Visible = False
- cmdEnterATSC.Visible = False
- cmdEnterAnalog.Visible = False
- lblChannel.Visible = False
- txtChannel.Visible = False
- cbSource.Visible = True
- lblSourceInUse.Visible = False
- lblMinorChannel.Visible = False
- txtMinorChannel.Visible = False
- lblPhysicalChannel.Visible = False
- txtPhysicalChannel.Visible = False
- cmdVolumeUp.Visible = False
- cmdVolumeDown.Visible = False
- cmdViewNext.Visible = False
- txtSID.Visible = False
- cmdEnterDVB.Visible = False
- lblSID.Visible = False
- lblInfo.Visible = False
- cmdInfo.Visible = False
- End Sub
- 'User presses Enter button to change a DVB-S channel
- Private Sub cmdEnterDVB_Click()
- On Error Resume Next
- DVBTune.SID = txtSID.Text
- VidControl.View DVBTune
- CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
- End Sub
- 'User presses Enter button to change a ATSC channel
- Private Sub cmdEnterATSC_Click()
- On Error Resume Next
- ATSCLoc.PhysicalChannel = txtPhysicalChannel.Text
- ATSCTune.Locator = ATSCLoc
- ATSCTune.MinorChannel = txtMinorChannel.Text
- ATSCTune.Channel = -1
- VidControl.View ATSCTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
- txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
- End Sub
- 'User presses Enter button to change a NTSC channel
- Private Sub cmdEnterAnalog_Click()
- On Error Resume Next
- AnalogTune.Channel = txtChannel.Text
- VidControl.View AnalogTune
- CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
- txtChannel.Text = VidControl.InputActive.Tune.Channel
- End Sub
- 'Change volume
- Private Sub cmdVolumeUp_Click()
- On Error Resume Next
- If (VidControl.AudioRendererActive.Volume < 0) Then
- VidControl.AudioRendererActive.Volume = VidControl.AudioRendererActive.Volume + 1000
- CheckError "There was a problem with changing the volume."
- 'Else
- ' MsgBox "Volume is set to maximum."
- End If
- End Sub
- 'Change volume
- Private Sub cmdVolumeDown_Click()
- On Error Resume Next
- If (VidControl.AudioRendererActive.Volume > -10000) Then
- VidControl.AudioRendererActive.Volume = VidControl.AudioRendererActive.Volume - 1000
- CheckError "There was a problem with changing the volume."
- 'Else
- ' MsgBox "Volume is set to minimum."
- End If
- End Sub
- 'Channel change up for ATSC
- Private Sub cmdSeekUpDigital_Click()
- On Error Resume Next
- ATSCLoc.PhysicalChannel = ATSCLoc.PhysicalChannel + 1
- ATSCTune.Locator = ATSCLoc
- ATSCTune.MinorChannel = -1
- ATSCTune.Channel = -1
- VidControl.View ATSCTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
- txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
- End Sub
- 'Channel change down for ATSC
- Private Sub cmdSeekDownDigital_Click()
- On Error Resume Next
- ATSCLoc.PhysicalChannel = ATSCLoc.PhysicalChannel - 1
- ATSCTune.Locator = ATSCLoc
- ATSCTune.MinorChannel = -1
- ATSCTune.Channel = -1
- VidControl.View ATSCTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
- txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
- End Sub
- 'Channel change up for NTSC
- Private Sub cmdSeekUpAnalog_Click()
- On Error Resume Next
- AnalogTune.Channel = AnalogTune.Channel + 1
- VidControl.View AnalogTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- txtChannel.Text = VidControl.InputActive.Tune.Channel
- End Sub
- 'Channel change down for NTSC
- Private Sub cmdSeekDownAnalog_Click()
- On Error Resume Next
- AnalogTune.Channel = AnalogTune.Channel - 1
- VidControl.View AnalogTune
- CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
- txtChannel.Text = VidControl.InputActive.Tune.Channel
- End Sub
- 'Capture current video frame and alpha blend over video
- Private Sub cmdCapture_Click()
- On Error Resume Next
- Dim Alpha As Integer
- Dim TempVidRend As MSVidVideoRenderer
- Dim MyRect As IMSVidRect
- Dim Pict As IPictureDisp
- 'The amount of opacity for the image over video is 75% visible
- Alpha = 75
- 'Get the current video renderer
- Set TempVidRend = VidControl.VideoRendererActive
- CheckError "Failed to retrieve the current video renderer."
- 'Capture the frame of video
- Set Pict = TempVidRend.Capture
- CheckError "Failed to capture the video frame."
- 'Set the properties for the image and then display it
- TempVidRend.MixerBitmap = Pict
- TempVidRend.MixerBitmapOpacity = Alpha
- Set MyRect = TempVidRend.MixerBitmapPositionRect
- MyRect.Top = 10
- MyRect.Left = 10
- MyRect.Height = (VidControl.Height) / 4
- MyRect.Width = (VidControl.Width) / 4
- TempVidRend.MixerBitmapPositionRect = MyRect
- CheckError "Failed to display the frame capture. Your video card may not be compatible with the WindowsXP Video Mixing Renderer."
- End Sub
- 'Remove the alpha blended image
- Private Sub cmdCaptureOff_Click()
- On Error Resume Next
- Dim TempVidRend As MSVidVideoRenderer
- Set TempVidRend = VidControl.VideoRendererActive
- CheckError "Failed to retrieve the current video renderer."
- TempVidRend.MixerBitmap = Nothing
- CheckError "Failed to disable MixerBitmap."
- End Sub
- Private Sub cmdViewNext_Click()
- 'Try the next tuner device
- On Error Resume Next
- VidControl.Stop
- If VidControl.InputActive.TuningSpace.CLSID = NTSC_GUID Then
- VidControl.ViewNext AnalogTune
- CheckError "Failed to ViewNext for NTSC."
- ElseIf VidControl.InputActive.TuningSpace.CLSID = ATSC_GUID Then
- VidControl.ViewNext ATSCTune
- CheckError "Failed to ViewNext for ATSC."
- ElseIf VidControl.InputActive.TuningSpace.CLSID = DVBS_GUID Then
- VidControl.ViewNext DVBTune
- CheckError "Failed to ViewNext for DVB."
- Else
- MsgBox "There is not a tuning space to match the current InputActive."
- End If
- VidControl.Run
- CheckError "Unable to run after changing InputActive."
- End Sub
- Private Sub cmdInfo_Click()
- 'Display Input Name and FPS
- lblInfo.Visible = True
- lblInfo.Caption = "Device Name: " & VidControl.InputActive.Name & " FPS: " & (VidControl.VideoRendererActive.FramesPerSecond / 100)
- End Sub
-